home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / int24.arc / INT24.PAS
Pascal/Delphi Source File  |  1985-03-05  |  7KB  |  201 lines
  1. { Thanks to Marshall Brain for the original code for this routine.
  2.  
  3.   These routines provide a method for Turbo Pascal programs to trap MS-DOS
  4. interrupt 24.  INT 24 is called by DOS when a 'critical error' occurs, and
  5. it normally prints the familiar "Abort, Retry, Ignore?" message.
  6.  
  7.   With the INT 24 handler installed, errors of this type will be passed on to
  8. Turbo Pascal as an error.  If I/O checking is on, this will cause a program
  9. crash.  If I/O checking is off, IOResult will return an error code.  The
  10. global variable INT24Err will be true if an INT 24 error has occurred.  The
  11. variable INT24ErrorCode will contain the INT 24 error code as given by DOS.
  12. These errors can be found in the DOS Technical Reference Manual.  They
  13. correspond to the error codes returned by the function INT24Result, with an
  14. offset of 256.  INT24Result is used like IOResult, and calls IOResult.  It
  15. then checks INT24Err, and if it is true, returns INT24ErrorCode+256 instead.
  16.  
  17.   In most cases, INT24Result should be used, because INT24Err must be set back
  18. to false, and because DOS sometimes restores its normal INT 24 handler after
  19. an error.
  20.  
  21.  
  22.   Note that Turbo's normal IOResult codes for MS-DOS DO NOT correspond to the
  23. I/O error numbers given in Appendix I of the Turbo Pascal manual, or to the
  24. error codes given in the I/O error nn, PC=aaaa/Program aborted message.  Here
  25. is a table of the correspondence (all numbers in hexadecimal):
  26.  
  27.   IOResult    Turbo error
  28.   --------    -------------------------------------------------
  29.      00          00  none
  30.      01          90  record length mismatch
  31.      02          01  file does not exist
  32.      03          F1  directory is full
  33.      04          FF  file disappeared
  34.      05          02  file not open for input
  35.      06          03  file not open for output
  36.      07          99  unexpected end of file
  37.      08          F0  disk write error
  38.      09          10  error in numeric format
  39.      0A          99  unexpected end of file
  40.      0B          F2  file size overflow
  41.      0C          99  unexpected end of file
  42.      0D          F0  disk write error
  43.      0E          91  seek beyond end of file
  44.      0F          04  file not open
  45.      10          20  operation not allowed on a logical device
  46.      11          21  not allowed in direct mode
  47.      12          22  assign to standard files is not allowed
  48.  
  49.   -  Bela Lubkin
  50. }
  51.  
  52. Const
  53.   INT24Err: Boolean=False;
  54.   INT24ErrCode: Byte=0;
  55.   OldINT24: Array [1..2] Of Integer=(0,0);
  56.  
  57. Var
  58.   RegisterSet: Record Case Integer Of
  59.                  1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  60.                  2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  61.                End;
  62.  
  63. Procedure INT24;
  64.   Begin
  65.     {To understand this routine, you will need to read}
  66.     {the description on Interrupt 24 in the DOS manual}
  67.     Inline
  68.      ($83/$C4/$0A);          {ADD SP,0AH   Discard first 5 words on stack}
  69.     INT24Err:=True;
  70.     Inline
  71.      ($89/$F8/               {MOV AX,DI    Get INT 24 error code}
  72.       $2E/$A2/INT24ErrCode/  {MOV CS:[INT24ErrCode],AL}
  73.       $58/                   {POP AX       Pop all registers}
  74.       $B0/$FF/               {MOV AL,0FFH  Set error flag}
  75.       $5B/                   {POP BX}
  76.       $59/                   {POP CX}
  77.       $5A/                   {POP DX}
  78.       $5E/                   {POP SI}
  79.       $5F/                   {POP DI}
  80.       $5D/                   {POP BP}
  81.       $1F/                   {POP DS}
  82.       $07/                   {POP ES}
  83.       $CF);                  {IRET    Return to next instruction}
  84.   End;
  85.  
  86. Procedure INT24On;  {Enable INT 24 trapping}
  87.   Begin
  88.     INT24Err:=False;
  89.     With RegisterSet Do
  90.      Begin
  91.       AX:=$3524;
  92.       MsDos(RegisterSet);
  93.       If (OldINT24[1] Or OldINT24[2])=0 Then
  94.        Begin
  95.         OldINT24[1]:=ES;
  96.         OldINT24[2]:=BX;
  97.        End;
  98.       DS:=CSeg;
  99.       DX:=Ofs(INT24);
  100.       AX:=$2524;
  101.       MsDos(RegisterSet);
  102.      End;
  103.   End;
  104.  
  105. Procedure INT24Off;  {Disable INT 24 trapping.  Should be done at the end
  106.                       of the program, if you plan to be running the program
  107.                       from within Turbo.}
  108.   Begin
  109.     INT24Err:=False;
  110.     If OldINT24[1]<>0 Then
  111.       With RegisterSet Do
  112.        Begin
  113.         DS:=OldINT24[1];
  114.         DX:=OldINT24[2];
  115.         AX:=$2524;
  116.         MsDos(RegisterSet);
  117.        End;
  118.     OldINT24[1]:=0;
  119.     OldINT24[2]:=0;
  120.   End;
  121.  
  122. Function INT24Result: Integer;
  123.   Var
  124.     I:Integer;
  125.  
  126.   Begin
  127.     I:=IOResult;
  128.     If INT24Err Then
  129.      Begin
  130.       I:=I+256*INT24ErrCode;
  131.       INT24On;
  132.      End;
  133.     INT24Result:=I;
  134.   End;
  135. { INT24Result returns all the regular Turbo IOResult codes if no critical
  136.   error has occurred.  If a critical error, then the following values are
  137.   added to the error code from Turbo (each is 256 times the INT24ErrorCode
  138.   value returned by DOS):
  139.    256:  Attempt to write on write protected disk
  140.    512:  Unknown unit                 [internal dos error]
  141.    768:  Drive not ready              [drive door open or bad drive]
  142.    1024: Unknown command              [internal dos error]
  143.    1280: Data error (CRC)             [bad sector or drive]
  144.    1536: Bad request structure length [internal dos error]
  145.    1792: Seek error                   [bad disk or drive]
  146.    2048: Unknown media type           [bad disk or drive]
  147.    2304: Sector not found             [bad disk or drive]
  148.    2560: Printer out of paper         [anything that the printer might signal]
  149.    2816: Write fault                  [character device not ready]
  150.    3072: Read fault                   [character device not ready]
  151.    3328: General failure              [several meanings]
  152.  
  153.   If you need the IOResult part, use
  154.    I:=INT24Result and 255; [masks out the INT 24 code]
  155.  
  156.   For the INT 24 code, use
  157.    I:=INT24Result Shr 8;   [same as Div 256, except faster]
  158.  
  159.   INT24Result clears both error codes, so you must assign it to a variable if
  160.   you want to extract both codes:
  161.    J:=INT24Result;
  162.    WriteLn('Turbo IOResult  = ',J And 255);
  163.    WriteLn('DOS INT 24 code = ',J Shr 8); }
  164.  
  165. { Main program.  Delete next line to enable }
  166. (**)
  167.  
  168. { Run this with printer off (or no printer), and nothing in drive A }
  169.  
  170. Var
  171.   F: File;
  172.   I: Integer;
  173.  
  174. Procedure PrinterTest;
  175.   Begin
  176.     WriteLn(LST,'test');
  177.     I:=INT24Result;
  178.     If I<>0 Then WriteLn('Printer error: ',I)
  179.     Else WriteLn('Printer OK');
  180.   End;
  181.  
  182. Procedure FileTest;
  183.   Begin
  184.     Assign(F,'A:FILE');
  185.     {$I-} Reset(F); {$I+}
  186.     I:=INT24Result;
  187.     If I<>0 Then WriteLn('Open failure on A:FILE :  INT24Result=',I)
  188.     Else WriteLn('A:FILE exists');
  189.     Close(F);
  190.   End;
  191.  
  192. Begin
  193.   INT24On;
  194.   PrinterTest;
  195.   FileTest;
  196.   PrinterTest;
  197.   INT24Off;
  198.   FileTest;
  199.   PrinterTest;
  200. End.
  201. (**)